Option Explicit
'Noms a ne pas changer : INDIRECTS, TOTAL INDIRECTS, GROS OEUVRES, ECA, CEA, CET, RISQUES TECHNIQUES IDENTIFIES, REVISION, INDIRECT DE PART PROPRE, RECETTES
Dim dcl As Byte
Sub maj_recap() 'Mise a jour de la feuille Recap IND
'Macro Dan pour S. cassandra - 22/05/17
'Dim dcl As Byte
Dim Lig As Byte
Dim dlg As Integer, ligind As Integer, i As Integer

Application.ScreenUpdating = False

With Sheets("RECAP IND")
    .Unprotect 'Deprotection feuille RECAP IND
    .Range("A12:D" & .Range("H" & .Rows.Count).End(xlUp).Row).ClearContents
End With

With Sheets("DETAILS")
    dcl = .Cells(6, .Columns.Count).End(xlToLeft).Column 'derniere colonne
    dlg = .Range("B" & .Rows.Count).End(xlUp).Row
    ligind = .Range("B:B").Find("INDIRECTS", LookIn:=xlValues).Row + 1 'repere de la ligne en dessous d'Indirects
    'couleur = 11581042 'couleur de fond vert fonc_
    
    For i = ligind To dlg

        If .Range("B" & i).Interior.Color = 12897954 Then
            Lig = Sheets("RECAP IND").Range("A" & Sheets("RECAP IND").Rows.Count).End(xlUp).Row + 1
            
            Sheets("DETAILS").Range("B" & i & ":E" & i).Copy
            Sheets("RECAP IND").Range("A" & Lig).PasteSpecial Paste:=xlValues
            Sheets("RECAP IND").Range("E" & Lig).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
            Sheets("RECAP IND").Range("F" & Lig) = Sheets("DETAILS").Cells(i, dcl - 1)
            Sheets("RECAP IND").Range("G" & Lig).FormulaR1C1 = "=RC[-2]-RC[-1]"
            Sheets("RECAP IND").Range("H" & Lig).FormulaR1C1 = "=RC[-1]/RC[-3]"
            Sheets("RECAP IND").Range("H" & Lig).NumberFormat = "#,##0.00%"
            
        End If
    Next
End With
With Sheets("RECAP IND")
    .Range("A" & Lig + 1) = "TOTAL INDIRECTS"
    .Range("B" & Lig + 1 & ":E" & Lig + 1).FormulaR1C1 = "=SUM(R[-" & Lig + 1 - 12 & "]C:R[-1]C)"
    .Range("F" & Lig + 1 & ":G" & Lig + 1).FormulaR1C1 = "=SUM(R[-" & Lig + 1 - 12 & "]C:R[-1]C)"
    .Range("H" & Lig + 1).FormulaR1C1 = "=RC[-1]/RC[-3]"
    .Rows(Lig + 2 & ":" & Lig + 100).Delete
End With

Call MiseformeRecap
Call maj_DCH_ECA_TS 'Mise a jour des feuilles DCH, Ecarts et TS
Call maj_Transfert 'Mise a jour feuille Transfert
Call Ecarts 'Mise a jour feuilles Ecart et Ecart Indirects
With Sheets("RECAP IND")
    .Select
    .Protect 'Protection feuille RECAP IND
End With
Application.ScreenUpdating = True
End Sub

Sub MiseformeRecap() 'mise en forme feuille Recap Ind
'Macro Dan pour S. cassandra - 22/05/17
Dim dlg As Byte
With ThisWorkbook.Sheets("RECAP IND")
    dlg = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A12:H12").Copy
    With .Range("A12:H" & dlg)
        .PasteSpecial Paste:=xlPasteFormats
        .VerticalAlignment = xlCenter
    End With

    Application.CutCopyMode = False
    With .Range("A12:I100")
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
    End With
    With .Range("A12:H" & dlg)
        .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlMedium
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 1
        End With
    End With
    
    With .Range("F12:F" & dlg)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 1
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = 1
        End With
    End With
    
    With .Range("A" & dlg & ":H" & dlg)
        .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlMedium
    End With

    .Rows("12:" & dlg).RowHeight = 25
End With
End Sub

Sub maj_DCH_ECA_TS() 'Mise a jour des feuilles DCH et TS
'Macro Dan pour S. Cassandra - 29/05/17
Dim Lig As Byte
Dim i As Integer
Dim j
j = 2

'MISE A JOUR DE LA FEUILLE DCH
With Sheets("DCH")
    .Unprotect 'Deprotection feuille DCH
    'Mise a jour lignes 16 a 20 depuis feuille Synthese DS
    
    For i = 16 To 19
        Union(.Cells(i, 6), .Range(.Cells(i, 8), .Cells(i, 10))) = 0 'Dan - 12/12/17 Pour avoir 0 en colonnes F,H,I,J
        .Cells(i, 6) = Sheets("SYNTHESE DS").Cells(i - j, 4)
        .Cells(i, 8) = Sheets("SYNTHESE DS").Cells(i - j, 6)
        .Cells(i, 9) = Sheets("SYNTHESE DS").Cells(i - j, 8)
        .Cells(i, 13) = Sheets("SYNTHESE DS").Cells(i - j, 12)
        j = j - 1
    Next i
End With

'Mise a jour lignes 23 a 25 depuis feuille details
Dim LigDet As Integer

With Sheets("DCH")
     LigDet = Sheets("DETAILS").Range("B:B").Find("GROS OEUVRES", LookIn:=xlValues).Row 'gros oeuvres
    Union(.Range("F23"), .Range("H23:J23"), .Range("M23")) = 0 'Dan - 12/12/17 Pour avoir 0 en colonnes F,H,I,J
    .Range("F23") = Sheets("DETAILS").Range("C" & LigDet)
    .Range("H23") = Sheets("DETAILS").Range("D" & LigDet)
    .Range("I23") = Sheets("DETAILS").Range("E" & LigDet)
    .Range("M23") = Sheets("DETAILS").Cells(LigDet, dcl - 1)
    
     LigDet = Sheets("DETAILS").Range("B:B").Find("CEA", LookIn:=xlValues).Row 'Corps etat architecturaux
    Union(.Range("F24"), .Range("H24:J24"), .Range("M24")) = 0 'Dan - 12/12/17 Pour avoir 0 en colonnes F,H,I,J
    .Range("F24") = Sheets("DETAILS").Range("C" & LigDet)
    .Range("H24") = Sheets("DETAILS").Range("D" & LigDet)
    .Range("I24") = Sheets("DETAILS").Range("E" & LigDet)
    .Range("M24") = Sheets("DETAILS").Cells(LigDet, dcl - 1)

     LigDet = Sheets("DETAILS").Range("B:B").Find("CET", LookIn:=xlValues).Row ' Corps Etat Techniques
    Union(.Range("F25"), .Range("H25:J25"), .Range("M25")) = 0 'Dan - 12/12/17 Pour avoir 0 en colonnes F,H,I,J
    .Range("F25") = Sheets("DETAILS").Range("C" & LigDet)
    .Range("H25") = Sheets("DETAILS").Range("D" & LigDet)
    .Range("I25") = Sheets("DETAILS").Range("E" & LigDet)
    .Range("M25") = Sheets("DETAILS").Cells(LigDet, dcl - 1)
End With

'Mise a jour lignes "Risque Technique Identifies" et "Revision" depuis feuille details
Dim LigDch As Integer
Dim LigRsq As Byte, LigOpp As Byte 'ligne feuille Risque et Ligne feuille Opp
With Sheets("DCH")
    LigDet = 0
    LigDch = .Range("B:C").Find("RISQUES TECHNIQUES IDENTIFIES", LookIn:=xlValues).Row

'-----------------------------------------------------------------------
'08/01/18 - lignes codes mises en suspend car calcul "Risques techniques identifies" est a effectuer meme si mention "Risques techniques identifies" non trouvee dans feuille Details

'    For i = 1 To 2
'        'Suppression des donnees de ligne avant remise a jour
'        Union(.Range("F" & LigDch), .Range("H" & LigDch & ":J" & LigDch), .Range("M" & LigDch)) = 0 'Dan - 11/12/17 Pour avoir 0 en colonne J
'
'        On Error Resume Next
'        LigDet = Sheets("DETAILS").Range("B:B").Find(.Range("B" & LigDch), LookIn:=xlValues).Row
'
'        If Err = 0 Then 'si ligDet trouvee dans en feuille Details
'            .Range("F" & LigDch) = Sheets("DETAILS").Range("C" & LigDet)
'            .Range("H" & LigDch) = Sheets("DETAILS").Range("D" & LigDet)
'            .Range("I" & LigDch) = Sheets("DETAILS").Range("E" & LigDet)
'            .Range("J" & LigDch) = 0 'Dan - 11/12/17 Pour avoir 0 en colonne J
'            Select Case .Range("B" & LigDch)
'                Case Is = "REVISION": .Range("M" & LigDch) = Sheets("DETAILS").Cells(LigDet, dcl - 1)
'                Case Else
'                    LigRsq = Sheets("Risques").Range("P" & Sheets("Risques").Rows.Count).End(xlUp).Row
'                    LigOpp = Sheets("OPP").Range("P" & Sheets("OPP").Rows.Count).End(xlUp).Row
'                    .Range("M" & LigDch).Value = (Sheets("Risques").Range("P" & LigRsq) - Sheets("OPP").Range("P" & LigOpp)) * 1000
'            End Select
'        End If
'        On Error GoTo 0
'        LigDch = .Range("B:C").Find("REVISION", LookIn:=xlValues).Row
'    Next i
'-------------------------------------------------------------------------
'08/01/18 - nouvelles lignes de code suite a mise en suspend lignes ci-avant
   
    'Suppression des donnees de ligne Risuues Yechnique identifies et Revision avant remise a jour
    Union(.Range("F" & LigDch & ":F" & LigDch + 1), .Range("H" & LigDch & ":J" & LigDch + 1), .Range("M" & LigDch & ":M" & LigDch + 1)) = 0
    
    'Mise a jour Risques techniques identifies
    LigRsq = Sheets("Risques").Range("P" & Sheets("Risques").Rows.Count).End(xlUp).Row
    LigOpp = Sheets("OPP").Range("P" & Sheets("OPP").Rows.Count).End(xlUp).Row
    .Range("M" & LigDch).Value = (Sheets("Risques").Range("P" & LigRsq) - Sheets("OPP").Range("P" & LigOpp)) * 1000

    'Mise a jour Revision
    On Error Resume Next
    LigDet = Sheets("DETAILS").Range("B:B").Find(.Range("B" & LigDch), LookIn:=xlValues).Row

    If Err = 0 Then 'si ligDet trouvee dans en feuille Details
        .Range("F" & LigDch) = Sheets("DETAILS").Range("C" & LigDet)
        .Range("H" & LigDch) = Sheets("DETAILS").Range("D" & LigDet)
        .Range("I" & LigDch) = Sheets("DETAILS").Range("E" & LigDet)
        .Range("J" & LigDch) = 0 'Dan - 11/12/17 Pour avoir 0 en colonne J
        .Range("M" & LigDch) = Sheets("DETAILS").Cells(LigDet, dcl - 1)
    End If
    On Error GoTo 0
End With

'Feuille DCH - Mise a jour lignes 29 a xx depuis feuille Recap Ind
Dim LigRti As Byte
LigDch = Sheets("DCH").Range("B:C").Find("INDIRECT DE PART PROPRE", LookIn:=xlValues).Row 'repere de la ligne avec mention "Indirect de part propre"
Lig = Sheets("RECAP IND").Range("A" & Sheets("RECAP IND").Rows.Count).End(xlUp).Row 'derniere ligne feuille recap ind
LigRti = Sheets("DCH").Range("B:C").Find("RISQUES TECHNIQUES IDENTIFIES", LookIn:=xlValues).Row 'repere de la ligne avec mention "Risques Techniques identifies"
For i = 12 To Lig - 1 'derniere ligne a copier de la feuille Recap ind
    With Sheets("DCH")
        'Suppression des donnees de ligne avant remise a jour
        Union(.Range("F" & i + 17), .Range("H" & i + 17), .Range("I" & i + 17), .Range("j" & i + 17), .Range("M" & i + 17)) = 0
        If i + 17 = LigDch Then .Rows(i + 17).Insert Shift:=xlDown: .Rows(i - 1 + 17).Copy .Rows(i + 17): LigDch = LigDch + 1
        .Range("B" & i + 17) = Sheets("RECAP IND").Range("A" & i)
        If Left(Sheets("RECAP IND").Range("A" & i), 8) = "DEPENSES" Then 'Depenses
            .Range("F" & i + 17) = Sheets("RECAP IND").Range("B" & i) - .Range("F" & LigRti) - .Range("F" & LigRti + 1) 'Pour decompter valeurs Risques techniques identifies et Revision
        Else
            .Range("F" & i + 17) = Sheets("RECAP IND").Range("B" & i)
        End If
        .Range("H" & i + 17) = Sheets("RECAP IND").Range("C" & i)
        If Left(Sheets("RECAP IND").Range("A" & i), 8) = "RECETTES" Then 'Recettes
            .Range("J" & i + 17) = Sheets("RECAP IND").Range("D" & i)
        Else: .Range("I" & i + 17) = Sheets("RECAP IND").Range("D" & i)
        End If
        .Range("M" & i + 17) = Sheets("RECAP IND").Range("F" & i)
        
    End With
Next i

'Ajout des formules ligne Indirect de Part Propre dans la feuille DCH
With Sheets("DCH")
    .Range("F" & LigDch).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    .Range("H" & LigDch).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    .Range("I" & LigDch).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    .Range("J" & LigDch).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    .Range("K" & LigDch).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    .Range("M" & LigDch).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    
'Suppression des lignes en trop dans feuille DCH
    While i + 17 < LigDch
        .Rows(i + 17).Delete Shift:=xlUp: LigDch = LigDch - 1
    Wend
    .Protect 'Protection feuille DCH
End With

'MISE A JOUR DE LA FEUILLE ECARTS - Mise a jour lignes 29 a xx depuis feuille DCH
Dim LigEca As Integer

With Sheets("ECARTS")
    .Unprotect 'Depoteger feuile ECARTS
    LigEca = .Range("B:C").Find("INDIRECT DE PART PROPRE", LookIn:=xlValues).Row 'repere de la ligne avec mention "Indirect de part propre"
    '.Range("B29:N" & LigEca - 1).ClearContents 'desactive le 12/10 pour eviter la suppression des lignes 29 et suivantes - Dan
    For i = 29 To LigDch - 1
        'Suppression des donnees de ligne avant remise a jour
        'Union(.Range("B" & i), .Range("D" & i), .Range("E" & i)) = ""
        If i = LigEca Then .Rows(i).Insert Shift:=xlDown: .Rows(i - 1).Copy .Rows(i): LigEca = LigEca + 1:
        .Range("B" & i) = Sheets("DCH").Range("B" & i)
        .Range("D" & i) = Sheets("DCH").Range("P" & i)
    Next i
    
    While i < LigEca
        .Rows(i).Delete Shift:=xlUp: LigEca = LigEca - 1
    Wend

    .Range("D" & LigEca).FormulaR1C1 = "=SUM(R29C:R[-1]C)"
    .Range("D" & LigEca + 5) = Sheets("DCH").Range("P" & LigDch + 5) 'Risques Techniques Identifies - 5 lignes en dessous de Indirect de part Propre
    .Range("D" & LigEca + 6) = Sheets("DCH").Range("P" & LigDch + 6) 'Revision - 6 lignes en dessous de Indirect de part Propre
    
    .Protect 'Protection feuille ECARTS
End With

'MISE A JOUR DE LA FEUILLE TS
Dim LigTS As Byte
With Sheets("TS")
    .Unprotect
    LigTS = .Range("B:C").Find("INDIRECTS", LookIn:=xlValues).Row 'repere de la ligne avec mention "Indirects"
    For i = 12 To Lig - 1 'derniere ligne a copier de la feuille Recap ind
        If i + 19 = LigTS Then .Rows(i + 19).Insert Shift:=xlDown: .Rows(i - 1 + 19).Copy .Rows(i + 19): .Rows(i + 19).ClearContents: LigTS = LigTS + 1
        '.Rows(i + 19).ClearContents 'desactive le 12/10 pour eviter la suppression des lignes 19 et suivantes - Dan
        .Range("B" & i + 19) = Sheets("RECAP IND").Range("A" & i)
    Next i
    'suppression des lignes en trop dans feuille TS
    While i + 19 < LigTS
        .Rows(i + 19).Delete Shift:=xlUp: LigTS = LigTS - 1
    Wend
    .Protect
End With
End Sub

